home *** CD-ROM | disk | FTP | other *** search
/ Point Programming 1 / PPROG1.ISO / pascal / swag / mail.swg / 0005_FIDONET *.MSG format.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-08-27  |  11.6 KB  |  429 lines
  1. {
  2. > I am trying to write a program.  Does anyone have the structures for the
  3. > FIDONET *.MSG format.  ANy help would be greatly appreciated.
  4. }
  5.  
  6. Unit FidoNet; { Beta Copy - Rev 6/5/89 - Tested 6/20/89  Ver. 0.31 }
  7.  
  8.            { FIDONET UNIT by Kelly Drown, Copyright (C)1988,89-LCP  }
  9.            {                                   All rights reserved  }
  10.            { If you use this unit in your own programming, I ask    }
  11.            { only that you give me credit in your documentation.    }
  12.            { I ask this instead of money. All of the following code }
  13.            { is covered under the copyright of Laser Computing Co.  }
  14.            { and may be used in your own programming provided the   }
  15.            { terms above have been satisfactorily met.              }
  16.  
  17. INTERFACE
  18.  
  19. Uses
  20.   Dos,
  21.   Crt,
  22.   StrnTTT5,  { TechnoJocks Turbo Toolkit v5.0 }
  23.   MiscTTT5;
  24.  
  25.  
  26. Type
  27.   NetMsg = Record        { NetMessage Record Structure }
  28.     From,
  29.     Too        : String[35];
  30.     Subject    : String[71];
  31.     Date       : String[19];
  32.     TimesRead,
  33.     DestNode,
  34.     OrigNode,
  35.     Cost,
  36.     OrigNet,
  37.     DestNet,
  38.     ReplyTo,
  39.     Attr,
  40.     NextReply  : Word;
  41.     AreaName   : String[20];
  42.   End;
  43.  
  44.   PktHeader = Record        { Packet Header of Packet }
  45.     OrigNode,
  46.     DestNode,
  47.     Year,
  48.     Month,
  49.     Day,
  50.     Hour,
  51.     Minute,
  52.     Second,
  53.     Baud,
  54.     OrigNet,
  55.     DestNet  : Word;
  56.   End;
  57.  
  58.   PktMessage = Record        { Packet Header of each individual message }
  59.     OrigNode,
  60.     DestNode,
  61.     OrigNet,
  62.     DestNet,
  63.     Attr,
  64.     Cost     : Word;
  65.     Date     : String[19];
  66.     Too      : String[35];
  67.     From     : String[35];
  68.     Subject  : String[71];
  69.     AreaName : String[20];
  70.   End;
  71.  
  72.   ArchiveName = Record        { Internal Record Structure used for     }
  73.     MyNet,                    { determining the name of of an echomail }
  74.     MyNode,                   { archive. i.e. 00FA1FD3.MO1             }
  75.     HisNet,
  76.     HisNode : Word;
  77.   End;
  78.  
  79. Const                        { Attribute Flags }
  80.   _Private  = $0001;
  81.   _Crash    = $0002;
  82.   _Recvd    = $0004;
  83.   _Sent     = $0008;
  84.   _File     = $0010;
  85.   _Forward  = $0020;     { Also know as In-Transit }
  86.   _Orphan   = $0040;
  87.   _KillSent = $0080;
  88.   _Local    = $0100;
  89.   _Hold     = $0200;
  90.   _Freq     = $0800;
  91.  
  92.   Status    : Array[1..12] Of String[3] =
  93.                 ('Jan','Feb','Mar','Apr','May','Jun',
  94.                  'Jul','Aug','Sep','Oct','Nov','Dec');
  95.  
  96. Var
  97.   Net  : NetMsg;
  98.   PH   : PktHeader;
  99.   PM   : PktMessage;
  100.   ArcN : ArchiveName;
  101.  
  102. Function  PacketName : String;
  103. Function  PacketMessage : String;
  104. Function  PacketHeader : String;
  105. Function  NetMessage : String;
  106. Function  GetPath(Var FName : String) : Boolean;
  107. Function  GetNet(GN : String) : String;
  108. Function  GetNode(GN : String) : String;
  109. Function  MsgDateStamp : String;
  110. Function  LastMsgNum(_NetPath : String) : Integer;
  111. Function  Hex(n : word) : String;
  112. Function  ArcName : String;
  113. Procedure ExpandNodeNumbers(Var List : String; VAR TotalNumber : Integer);
  114. Procedure Conv_NetNode(NetNode : String; VAR Net, Node : Word);
  115.  
  116. IMPLEMENTATION
  117.  
  118. {-------------------------------------------------------------------------}
  119. Function PacketName : String;
  120. { Creates and returns a unique Packet name }
  121. Var
  122.   h, m, s,
  123.   hs, yr,
  124.   mo, da,
  125.   dow     : Word;
  126.   WrkStr  : String;
  127. Begin
  128.   WrkStr := '';
  129.   GetTime(h, m, s, hs);
  130.   GetDate(yr, mo, da, dow);
  131.  
  132.   WrkStr := PadRight(Int_To_Str(da), 2, '0')
  133.            + PadRight(Int_To_Str(h), 2, '0')
  134.            + PadRight(Int_To_Str(m), 2, '0')
  135.            + PadRight(Int_To_Str(s), 2, '0');
  136.  
  137.   PacketName := WrkStr + '.PKT';
  138. End;
  139. {-------------------------------------------------------------------------}
  140. Function PacketMessage : String;
  141. { Returns a Packet message header }
  142. Var
  143.   Hdr : String;
  144. Begin
  145.   Hdr := '';
  146.  
  147.   Hdr := #2#0 { Type #2 packets... Type #1 is obsolete }
  148.          + Chr(Lo(PM.OrigNode)) + Chr(Hi(PM.OrigNode))
  149.          + Chr(Lo(PM.DestNode)) + Chr(Hi(PM.DestNode))
  150.          + Chr(Lo(PM.OrigNet)) + Chr(Hi(PM.OrigNet))
  151.          + Chr(Lo(PM.DestNet)) + Chr(Hi(PM.DestNet))
  152.          + Chr(Lo(PM.Attr)) + Chr(Hi(PM.Attr))
  153.          + Chr(Lo(PM.Cost)) + Chr(Hi(PM.Cost))
  154.          + PM.Date + #0 + PM.Too + #0 + PM.From + #0 + PM.Subject + #0
  155.          + Upper(PM.AreaName);
  156.  
  157.   PacketMessage := Hdr;
  158. End;
  159. {-------------------------------------------------------------------------}
  160. Function PacketHeader : String;
  161. { Returns a Packet Header String }
  162. Var
  163.   Hdr : String;
  164. Begin
  165.   Hdr := '';
  166.  
  167.   Hdr := Chr(Lo(PH.OrigNode)) + Chr(Hi(PH.OrigNode))
  168.          + Chr(Lo(PH.DestNode)) + Chr(Hi(PH.DestNode))
  169.          + Chr(Lo(PH.Year)) + Chr(Hi(PH.Year))
  170.          + Chr(Lo(PH.Month)) + Chr(Hi(PH.Month))
  171.          + Chr(Lo(PH.Day)) + Chr(Hi(PH.Day))
  172.          + Chr(Lo(PH.Hour)) + Chr(Hi(PH.Hour))
  173.          + Chr(Lo(PH.Minute)) + Chr(Hi(PH.Minute))
  174.          + Chr(Lo(PH.Second)) + Chr(Hi(PH.Second))
  175.          + Chr(Lo(PH.Baud)) + Chr(Hi(PH.Baud))
  176.          + #2#0 + Chr(Lo(PH.OrigNet)) + Chr(Hi(PH.OrigNet))
  177.          + Chr(Lo(PH.DestNet)) + Chr(Hi(PH.DestNet))
  178.          + #0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0   { Null Field Fill Space }
  179.          + #0#0#0#0#0#0#0#0#0#0#0#0#0#0#0;
  180.  
  181.   PacketHeader := Hdr;
  182. End;
  183. {-------------------------------------------------------------------------}
  184. Function NetMessage : String;
  185. { Returns a NetMessage header string }
  186. Var
  187.   Hdr : String;
  188. Begin
  189.   Hdr := '';
  190.  
  191.   Hdr := PadLeft(Net.From, 36, #0);
  192.   Hdr := Hdr + PadLeft(Net.Too, 36, #0)
  193.              + PadLeft(Net.Subject, 72, #0)
  194.              + PadRight(Net.Date, 19, ' ') + #0
  195.              + Chr(Lo(Net.TimesRead)) + Chr(Hi(Net.TimesRead))
  196.              + Chr(Lo(Net.DestNode)) + Chr(Hi(Net.DestNode))
  197.              + Chr(Lo(Net.OrigNode)) + Chr(Hi(Net.OrigNode))
  198.              + Chr(Lo(Net.Cost)) + Chr(Hi(Net.Cost))
  199.              + Chr(Lo(Net.OrigNet)) + Chr(Hi(Net.OrigNet))
  200.              + Chr(Lo(Net.DestNet)) + Chr(Hi(Net.DestNet))
  201.              + #0#0#0#0#0#0#0#0
  202.              + Chr(Lo(Net.ReplyTo)) + Chr(Hi(Net.ReplyTo))
  203.              + Chr(Lo(Net.Attr)) + Chr(Hi(Net.Attr))
  204.              + Chr(Lo(Net.NextReply)) + Chr(Hi(Net.NextReply))
  205.              + Upper(Net.AreaName);
  206.  
  207.   NetMessage := Hdr;
  208. End;
  209. {-------------------------------------------------------------------------}
  210. Function GetPath(Var FName : String) : Boolean;
  211. { Returns the FULL Path and filename for a filename if the file  }
  212. { is found in the path. }
  213. Var
  214.   Str1,
  215.   Str2    : String;
  216.   NR      : Byte;
  217.   HomeDir : String;
  218. Begin
  219.   HomeDir := FExpand(FName);
  220.   If Exist(HomeDir) Then
  221.   Begin
  222.     FName   := HomeDir;
  223.     GetPath := True;
  224.     Exit;
  225.   End;
  226.  
  227.   Str1 := GetEnv('PATH');
  228.   For NR := 1 to Length(Str1) DO
  229.     IF Str1[NR] = ';' Then
  230.       Str1[NR] := ' ';
  231.  
  232.   For NR := 1 to WordCnt(Str1) DO
  233.   Begin
  234.     Str2 := ExtractWords(NR, 1, Str1) + '\' + FName;
  235.     IF Exist(Str2) Then
  236.     Begin
  237.       FName   := Str2;
  238.       GetPath := True;
  239.       Exit;
  240.     End;
  241.   End;
  242.   GetPath := False;
  243. End;
  244.  
  245. {-------------------------------------------------------------------------}
  246. Function MsgDateStamp : String;  { Creates Fido standard- 01 Jan 89 21:05:18 }
  247. Var                              { Standard message header time/date stamp   }
  248.   h, m, s,
  249.   hs, y, mo,
  250.   d, dow    : Word;
  251.   Tmp, o1,
  252.   o2, o3    : String;
  253.  
  254. Begin
  255.   o1  := '';
  256.   o2  := '';
  257.   o3  := '';
  258.   tmp := '';
  259.   GetDate(y, mo, d, dow);
  260.   GetTime(h, m, s, hs);
  261.   o1  := PadRight(Int_To_Str(d), 2, '0');
  262.   o2  := Status[mo];
  263.   o3  := Last(2,Int_To_Str(y));
  264.   Tmp := Concat(o1, ' ', o2, ' ', o3,'  ');
  265.   o1  := PadRight(Int_To_Str(h), 2, '0');
  266.   o2  := PadRight(Int_To_Str(m), 2, '0');
  267.   o3  := PadRight(Int_To_Str(s), 2, '0');
  268.   Tmp := Tmp + Concat(o1, ':', o2, ':', o3);
  269.   MsgDateStamp := Tmp;
  270. End;
  271.  
  272. {-------------------------------------------------------------------------}
  273. Function MsgToNum(Fnm : String) : Integer; { Used Internally by LastMsgNum }
  274. Var
  275.   p : Byte;
  276. Begin
  277.   p        := Pos('.', Fnm);
  278.   Fnm      := First(p - 1, Fnm);
  279.   MsgToNum := Str_To_Int(Fnm);
  280. End;
  281. {-------------------------------------------------------------------------}
  282.  
  283. Function LastMsgNum(_NetPath : String) : Integer;
  284. { Returns the highest numbered xxx.MSG in NetPath directory }
  285. Var
  286.   _Path,
  287.   Temp1,
  288.   Temp2   : String;
  289.   Len     : Byte;
  290.   DxirInf : SearchRec;
  291.   Num,
  292.   Num1    : Integer;
  293.  
  294. Begin
  295.   Num   := 0;
  296.   Num1  := 0;
  297.   Temp1 := '';
  298.   Temp2 := '';
  299.   _Path := '';
  300.   _Path := _NetPath + '\*.MSG';
  301.  
  302.   FindFirst(_Path, Archive, DxirInf);
  303.   While DosError = 0 DO
  304.   Begin
  305.     Temp1 := DxirInf.Name;
  306.     Num1 := MsgToNum(Temp1);
  307.     IF Num1 > Num Then
  308.       Num := Num1;
  309.     FindNext(DxirInf);
  310.   End;
  311.  
  312.   IF Num = 0 Then
  313.     Num := 1;
  314.   LastMsgNum := Num;
  315. End;
  316.  
  317. {-------------------------------------------------------------------------}
  318. Function Hex(N : Word) : String;
  319. { Converts an integer or word to it's Hex equivelent }
  320. Var
  321.   L   : string[16];
  322.   BHi,
  323.   BLo : byte;
  324.  
  325. Begin
  326.   L   := '0123456789ABCDEF';
  327.   BHi := Hi(n);
  328.   BLo := Lo(n);
  329.   Hex := copy(L,succ(BHi shr 4),  1) +
  330.          copy(L,succ(BHi and 15), 1) +
  331.          copy(L,succ(BLo shr 4),  1) +
  332.          copy(L,succ(BLo and 15), 1);
  333. End;
  334.  
  335. {-------------------------------------------------------------------------}
  336. Function ArcName : String;
  337. { Returns the proper name of an echomail archive }
  338. Var
  339.   C1, C2 : LongInt;
  340. Begin
  341.   C1 := 0;
  342.   C2 := 0;
  343.   C1 := ArcN.MyNet - ArcN.HisNet;
  344.   C2 := ArcN.MyNode - ArcN.HisNode;
  345.   If C1 < 0 Then
  346.     C1 := 65535 + C1;
  347.   If C2 < 0 Then
  348.     C2 := 65535 + C2;
  349.   ArcName := Hex(C1) + Hex(C2);
  350. End;
  351.  
  352. {-------------------------------------------------------------------------}
  353. Function GetNet(GN : String) : String;
  354. { Returns the NET portion of a Net/Node string }
  355. Var
  356.   P : Byte;
  357. Begin
  358.   P := Pos('/', GN);
  359.   GetNet := First(P - 1, GN);
  360. End;
  361.  
  362. {-------------------------------------------------------------------------}
  363. Function GetNode(GN : String) : String;
  364. { Returns the NODE portion of a Net/Node string }
  365. Var
  366.   P : Byte;
  367. Begin
  368.   P := Pos('/', GN);
  369.   GetNode := Last(Length(GN) - P, GN);
  370. End;
  371. {-------------------------------------------------------------------------}
  372. Procedure ExpandNodeNumbers(Var List : String; VAR TotalNumber : Integer );
  373. { Expands a list of short form node numbers to thier proper       }
  374. { Net/Node representations. Example:                              }
  375. { The string: 170/100 101 102 5 114/12 15 17 166/225 226          }
  376. { Would return: 170/100 170/101 170/102 170/5 114/12 114/15 etc.. }
  377. Var
  378.   Net,
  379.   NetNode  : String[10];
  380.   HoldStr,
  381.   WS1      : String;
  382.   N1       : Integer;
  383.  
  384. Begin
  385.   Net := '';
  386.   NetNode := '';
  387.   HoldStr := '';
  388.   WS1 := '';
  389.   N1  := 0;
  390.   TotalNumber := 0;
  391.   TotalNumber := WordCnt(List);
  392.  
  393.   For N1 := 1 to TotalNumber DO
  394.   Begin
  395.     WS1 := ExtractWords(N1, 1, List);
  396.     IF Pos('/', WS1) <> 0 Then
  397.     Begin
  398.       Net := GetNet(WS1) + '/';
  399.       NetNode := WS1;
  400.     End
  401.     ELSE
  402.       NetNode := Net + WS1;
  403.     HoldStr := HoldStr + ' ' + Strip('A', ' ', NetNode);
  404.   End;
  405. End;
  406.  
  407. {-------------------------------------------------------------------------}
  408. Procedure Conv_NetNode(NetNode : String; VAR Net, Node : Word);
  409. { Returns NET and NODE as words from a Net/Node string }
  410. Var
  411.   WStr : String[6];
  412. Begin
  413.   Wstr := GetNet(NetNode);
  414.   Net  := Str_To_Int(Wstr);
  415.   Wstr := GetNode(NetNode);
  416.   Node := Str_To_Int(Wstr);
  417. End;
  418. {-------------------------------------------------------------------------}
  419.  
  420. Begin
  421.   { Initialize the data structures }
  422.  
  423.   FillChar(Net, SizeOf(Net), #0);
  424.   FillChar(PM, SizeOf(PM), #0);
  425.   FillChar(PH, SizeOf(PH), #0);
  426.   FillChar(ArcN, SizeOf(ArcN), #0);
  427.  
  428. End. {Unit}
  429.